Shareware Overload Trio 2

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / c7105.zip / BRWSGRPS.TPX < prev next >

Wrap

Text File | 1994-03-02 | 50KB | 1,039 lines

#!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐ #!│ BrwsGrps.TPX │Version: 3007.105│ #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤ #!│Structure Type Description │ #!│──────────────────── ───────── ─────────────────────────────────────────│ #!│SetBrowseSymbols GROUP │ #!│AddFixedListLines GROUP │ #!│BeginBrowse GROUP │ #!│FillKeyValues GROUP │ #!│BrowseErrorCheck GROUP │ #!│ClearFileFields GROUP │ #!│TotalBeforeUpdate GROUP │ #!│TotalAfterUpdate GROUP │ #!│AddTotalValues GROUP │ #!│UpdateTotalValues GROUP │ #!│ClearTotalValues GROUP │ #!│SetupKeyRangeFields GROUP │ #!│SaveRangeFields GROUP │ #!│RestoreRangeFields GROUP │ #!│CheckKeyRangeFields GROUP │ #!│RangeComparison GROUP │ #!│EditCodeInsert GROUP │ #!│EditCodeChange GROUP │ #!│EditCodeDelete GROUP │ #!│EditCodeSelect GROUP │ #!│EditCodeExit GROUP │ #!│EditCodeCancel GROUP │ #!│EditCodeLocator GROUP │ #!│EditCodeList GROUP │ #!│ClearRecordHigh GROUP │ #!│ClearRecordLow GROUP │ #!│LookupValidateCode GROUP │ #!│LookupRecord GROUP │ #!│IsUpdateSuccessful GROUP │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.101 Repaired %SetBrowseSymbols GROUP │ #!│ Repaired %UpdateTotalValues GROUP │ #!│3007.102 Repaired %EditCodeInsert GROUP │ #!│ Repaired %EditCodeChange GROUP │ #!│ Repaired %EditCodeDelete GROUP │ #!│3007.103 Repaired %EditCodeList GROUP │ #!│ Repaired %LookupValidateCode #GROUP │ #!│ Added %EditCodeLocator #GROUP │ #!│3007.105 Repaired %EditCodeList GROUP │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #GROUP(%SetBrowseSymbols) #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ SetBrowseSymbols │Version: 3007.101│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Determine operating parameters of a Browse-type procedure │ #!│Called From: Browse,Validate,Lookup,Select │ #!│Assumptions: None │ #!│Inserts: None │ #!│Symbols Set: Most Browse Symbols │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.101 Changed Hot Fields code to exclude the Locator from displayed │ #!│ fields and to add pre-?List fields │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #SET(%FirstEntryField,%Null) #SET(%PreListEntry,%Null) #SET(%UpdateButtonsExist,%Null) #SET(%KeyboardInsert,%Null) #SET(%KeyboardChange,%Null) #SET(%KeyboardDelete,%Null) #SET(%KeyboardSelect,%Null) #SET(%InsertExists,%Null) #SET(%ChangeExists,%Null) #SET(%DeleteExists,%Null) #SET(%SelectExists,%Null) #SET(%ExitExists,%Null) #SET(%FilterExists,%Null) #SET(%HotKeyExists,%Null) #SET(%ScreenFldSetupExists,%Null) #SET(%ScreenFldEditExists,%Null) #SET(%ControlRelatedFiles,%Null) #SET(%TotalExists,%Null) #SET(%TotalFormulas,%Null) #SET(%FirstHotField,%Null) #SET(%SecondHotField,%Null) #SET(%ThirdHotField,%Null) #SET(%FourthHotField,%Null) #SET(%FifthHotField,%Null) #SET(%SixthHotField,%Null) #FIX(%File,%Primary) #FOR(%HotKey) #SET(%HotKeyExists,'YES') #BREAK #ENDFOR #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'FILTER') #SET(%FilterExists, 'YES') #ENDIF #ENDFOR #IF(%RecordFilter) #SET(%FilterExists, 'YES') #ENDIF #SET(%FirstEntryFound,%Null) #FOR(%ScreenField) #SET(%ScreenFieldExists,'YES') #IF(%FirstEntryFound = %Null) #SET(%FirstEntryField, (%FirstEntryField + 1)) #IF(%ScreenFieldSkip <> 'Y') #SET(%FirstEntryFound,'YES') #ENDIF #ENDIF #IF(%ScreenFieldType = 'BUTTON') #IF(UPPER(%ScreenField) = '?INSERT') #SET(%UpdateButtonsExist, 'YES') #SET(%InsertExists, 'YES') #SET(%KeyboardInsert,'YES') #ELSIF(UPPER(%ScreenField) = '?CHANGE') #SET(%UpdateButtonsExist, 'YES') #SET(%ChangeExists, 'YES') #SET(%KeyboardChange,'YES') #ELSIF(UPPER(%ScreenField) = '?DELETE') #SET(%UpdateButtonsExist, 'YES') #SET(%DeleteExists, 'YES') #SET(%KeyboardDelete,'YES') #ELSIF(UPPER(%ScreenField) = '?SELECT') #SET(%UpdateButtonsExist, 'YES') #SET(%SelectExists, 'YES') #SET(%KeyboardSelect,'YES') #ELSIF(UPPER(%ScreenField) = '?EXIT') #SET(%ExitExists, 'YES') #ENDIF #ENDIF #ENDFOR #IF(%UpdateButtonsExist=%Null) #SET(%KeyboardInsert,'YES') #SET(%KeyboardChange,'YES') #SET(%KeyboardDelete,'YES') #SET(%KeyboardSelect,'YES') #ENDIF #IF(%ScreenFieldSetup) #SET(%ScreenFldSetupExists,'YES') #ENDIF #IF(%ScreenFieldEdit) #SET(%ScreenFldEditExists,'YES') #ENDIF #SET(%FixRows, '0') #FIX(%ScreenField,'?List') #FOR(%ScreenFieldFix) #SET(%FixRows, (%FixRows + 1)) #ENDFOR #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'SUM') #SET(%TotalFormulas,'TRUE') #BREAK #ELSIF(UPPER(%FormulaClass) = 'AVG') #SET(%TotalFormulas,'TRUE') #BREAK #ELSIF(UPPER(%FormulaClass) = 'CNT') #SET(%TotalFormulas,'TRUE') #BREAK #ENDIF #ENDFOR #IF(%TotalsOn OR %TotalFormulas) #SET(%TotalExists, 'TRUE') #IF(%KeyRangeField) #FOR(%ScreenField) #IF(UPPER(%ScreenField)='?LIST') #BREAK #ENDIF #IF(%ScreenFieldType='ENTRY') #IF(%ScreenFieldSkip <> 'Y') #IF(UPPER(%ScreenFieldUse)<>UPPER(%Locator)) #SET(%PreListEntry,'TRUE') #BREAK #ENDIF #ENDIF #ENDIF #ENDFOR #ENDIF #ENDIF #IF(%HotBar) #! IF updating screen on key #SET(%ListFound,%Null) #! CLEAR Flag (Last Found?) #SET(%LocatorFound,%Null) #! CLEAR Flag (Locator Found?) #FOR(%ScreenField) #! Cycle through screen fields #IF(%ListFound=%Null) #! IF ?List not processed #IF(UPPER(%ScreenField)='?LIST') #! IF %ScreenField is ?List #SET(%ListFound,'TRUE') #! SET the Flag #ELSE #! ELSE (IF %ScreenField...) #IF(%FirstHotField) #! IF we've got a start #SET(%SecondHotField,%ScreenField) #! Get an end #ELSE #! ELSE (If we've got...) #SET(%FirstHotField,%ScreenField) #! Get a start #ENDIF #! END (If we've got...) #ENDIF #! END (If %ScreenField...) #ELSIF(%LocatorFound=%Null) #! ELSIF Locator not processed #IF(UPPER(%ScreenFieldUse)=UPPER(%Locator)) #! IF %ScreenFieldUse is %Locator #SET(%LocatorFound,'TRUE') #! SET the Flag #ELSE #! ELSE (IF %ScreenField...) #IF(%ThirdHotField) #! IF we've got a start #SET(%FourthHotField,%ScreenField) #! Get an end #ELSE #! ELSE (If we've got...) #SET(%ThirdHotField,%ScreenField) #! Get a start #ENDIF #! END (If we've got...) #ENDIF #! END (If %ScreenField...) #ELSE #! ELSE (Past Locator) #IF(%FifthHotField) #! IF we've got a start #SET(%SixthHotField,%ScreenField) #! Get an end #ELSE #! ELSE (If we've got...) #SET(%FifthHotField,%ScreenField) #! Get a start #ENDIF #! END (If we've got...) #ENDIF #! END (IF List not...) #ENDFOR #! END (cycle through screen...) #ENDIF #! END (IF updating screen...) #! #! #!*************************************************************************** #GROUP(%AddFixedListLines) #!Group to add any QUEUE fixed #FIX(%ScreenField,'?List') #! lines to the QUEUE. #FOR(%ScreenFieldFix) Queue = %ScreenFieldFix #<!Add fixed listbox line ADD(Queue) ! to the QUEUE #ENDFOR #!*************************************************************************** #GROUP(%BeginBrowse) #IF(%NoMemo) #IF(%Locator) #!Conditionally initialize #IF(%IncrementalLocator) #IF(%HotBar) #! the browse session manager BeginBrowse(?List,?%Locator,1,1,1) #<!Begin a browse session #ELSE BeginBrowse(?List,?%Locator,,1,1) #<!Begin a browse session #ENDIF #ELSE #IF(%HotBar) #! the browse session manager BeginBrowse(?List,?%Locator,1,,1) #<!Begin a browse session #ELSE BeginBrowse(?List,?%Locator,,,1) #<!Begin a browse session #ENDIF #ENDIF #ELSE #IF(%HotBar) BeginBrowse(?List,,1,,1) #<!Begin a browse session #ELSE BeginBrowse(?List,,,,1) #<!Begin a browse session #ENDIF #ENDIF #ELSE #IF(%Locator) #!Conditionally initialize #IF(%IncrementalLocator) #IF(%HotBar) #! the browse session manager BeginBrowse(?List,?%Locator,1,1) #<!Begin a browse session #ELSE BeginBrowse(?List,?%Locator,,1) #<!Begin a browse session #ENDIF #ELSE #IF(%HotBar) #! the browse session manager BeginBrowse(?List,?%Locator,1) #<!Begin a browse session #ELSE BeginBrowse(?List,?%Locator) #<!Begin a browse session #ENDIF #ENDIF #ELSE #IF(%HotBar) BeginBrowse(?List,,1) #<!Begin a browse session #ELSE BeginBrowse(?List) #<!Begin a browse session #ENDIF #ENDIF #ENDIF #!*************************************************************************** #GROUP(%FillKeyValues) #FOR(%KeyField) QUE::%KeyField =%KeyField #<! Fill any key fields #ENDFOR #! #!*************************************************************************** #GROUP(%BrowseErrorCheck) #! #IF(%Primary = %Null) #SET(%ErrorMessage, (%Procedure & ' ERROR: No file has been chosen for this procedure.')) #ERROR(%ErrorMessage) #SET(%ErrorMessage, ' A file must be selected for this procedure.') #ERROR(%ErrorMessage) #ENDIF #IF(%PrimaryKey = %Null) #SET(%ErrorMessage, (%Procedure & ' ERROR: No Access Key has been chosen for this procedure.')) #ERROR(%ErrorMessage) #SET(%ErrorMessage, ' An Access Key must be identified on the File Schematic.') #ERROR(%ErrorMessage) #ENDIF #IF(%KeyRangeField) #IF(UPPER(%KeyRangeField) = UPPER(%RangeValue)) #SET(%ErrorMessage, (%Procedure & ' ERROR: Range Limit Field and Range Value fields must')) #ERROR(%ErrorMessage) #SET(%ErrorMessage, ' be separate fields.') #ERROR(%ErrorMessage) #ENDIF #ENDIF #FIX(%File,%Primary) #IF(%DisplayKey) #FIX(%Key,%DisplayKey) #ELSE #FIX(%Key,%PrimaryKey) #ENDIF #IF(%Locator) #SET(%FieldFound,%Null) #FOR(%KeyField) #IF(UPPER(%KeyField) = UPPER(%Locator)) #SET(%FieldFound,'Yes') #BREAK #ENDIF #ENDFOR #IF(%FieldFound = %Null) #SET(%ErrorMessage, (%Procedure & ' ERROR: the Locator Field must be a component of')) #ERROR(%ErrorMessage) #SET(%ErrorMessage, (' the ' & %Key & ' key.')) #ERROR(%ErrorMessage) #ENDIF #ENDIF #IF((UPPER(%ProcedureTemplate)='BROWSE' OR UPPER(%ProcedureTemplate)='SELECT')) #FIX(%Key,%PrimaryKey) #ELSE #IF(%DisplayKey) #FIX(%Key,%DisplayKey) #ELSE #FIX(%Key,%PrimaryKey) #ENDIF #ENDIF #IF(%KeyRangeField) #SET(%FieldFound,%Null) #FOR(%KeyField) #IF(UPPER(%KeyField) = UPPER(%KeyRangeField)) #SET(%FieldFound,'Yes') #BREAK #ENDIF #ENDFOR #IF(%FieldFound = %Null) #SET(%ErrorMessage, (%Procedure & ' ERROR: Key Range Limit Field must be a component of the')) #ERROR(%ErrorMessage) #SET(%ErrorMessage, ' File Access Key') #ERROR(%ErrorMessage) #ENDIF #ENDIF #! #!*************************************************************************** #GROUP(%ClearFileFields) #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ ClearFileFields │Version: 3007.101│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Clear out a File's record structure and memos. │ #!│Called From: Various INSERTS from BROWSE type procedures │ #!│Assumptions: That %File is FIXed │ #!│Inserts: None │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.101 Modified to support the clearing of BINARY memos to low values │ #!│ CLEAR(%Field,-1). Before, all memos were cleared to 0. │ #!└──────────────────────────────────────────────────────────────────────────┘ #! CLEAR(%FilePre:Record) #<! CLEAR Record buffer #FOR(%FileMemo) #! Cycle through each memo #FIX(%Field,%FileMemo) #! FIX the field to the memo #IF(%FieldMemoImage='Y') #! IF a Binary memo CLEAR(%Field,-1) #<! CLEAR BINARY Memo buffer #ELSE #! ELSE (IF not a Binary...) CLEAR(%Field) #<! CLEAR Memo buffer #ENDIF #! END (IF a Binary...) #ENDFOR #! END (Cycle through each...) #!*************************************************************************** #GROUP(%TotalBeforeUpdate) #!Group Containing Browse totals #IF(%TotalExists) #! If we are doing totals #INSERT(%GetSecondaryRecords) #! Lookup any secondaries #IF(%TotalFormulas) #! If Formulas compute totals #IF(%KeyboardChange OR %KeyboardDelete) #! IF Change or Delete Active CASE UpdateMode #<! Check how update is called #IF(%KeyboardChange AND %KeyboardDelete) OF ChangeRecord OROF DeleteRecord #<! Changing or Deleting #ELSIF(%KeyboardChange) OF ChangeRecord #<! Changing #ELSE OF DeleteRecord #<! Deleting #ENDIF #FOR(%Formula) #! Cycle through the formulas #IF(%FormulaType = 'COMPUTED') #! If using COMPUTED formula #IF((UPPER(%FormulaClass)='SUM' OR UPPER(%FormulaClass)='AVG')) Old::%Formula$ = %FormulaComputation #<! TOTAL:%FormulaDescription #ENDIF #IF((UPPER(%FormulaClass)='CNT' OR UPPER(%FormulaClass)='AVG')) Old::%Formula# = 1 #<! TOTAL:%FormulaDescription #ENDIF #ELSE #! otherwise (CONDITION formula) #IF((UPPER(%FormulaClass)='SUM' OR UPPER(%FormulaClass)='AVG')) Old::%Formula$ = 0 #! If Average or Counting #ENDIF #IF((UPPER(%FormulaClass)='CNT' OR UPPER(%FormulaClass)='AVG')) Old::%Formula# = 0 #! If Average or Counting #ENDIF IF %FormulaCondition #<! TOTAL:%FormulaDescription #IF((UPPER(%FormulaClass)='SUM' OR UPPER(%FormulaClass)='AVG')) Old::%Formula$ = %FormulaTrue #! If Average or Counting #ENDIF #IF((UPPER(%FormulaClass)='CNT' OR UPPER(%FormulaClass)='AVG')) Old::%Formula# = 1 #! If Average or Counting #ENDIF #IF(%FormulaFalse) #! If there is a FALSE value ELSE #<! otherwise (FALSE) #IF((UPPER(%FormulaClass)='SUM' OR UPPER(%FormulaClass)='AVG')) Old::%Formula$ = %FormulaFalse #! If Average or Counting #ENDIF #IF((UPPER(%FormulaClass)='CNT' OR UPPER(%FormulaClass)='AVG')) Old::%Formula# = 1 #! If Average or Counting #ENDIF #ENDIF END #<! END (If condition is true) #ENDIF #! ENDIF (FormulaClass...) #ENDFOR #! ENDFOR (Formula...) END #<! END (CASE KEYCODE()...) #ENDIF #! END (If Change or ...) #ENDIF #! END (If Formulas...) #ENDIF #! ENDIF (TotalsExist...) #!*************************************************************************** #GROUP(%TotalAfterUpdate) #IF(%TotalExists) #INSERT(%GetSecondaryRecords) #IF(%TotalFormulas) #! If Formulas compute totals IF UpdateSuccessful #IF(%KeyboardChange OR %KeyboardDelete) #! IF Change or Delete Active #IF(%KeyboardChange AND %KeyboardDelete) IF UpdateMode = ChangeRecord OR UpdateMode = DeleteRecord #ELSIF(%KeyboardChange) IF UpdateMode = ChangeRecord #ELSE IF UpdateMode = DeleteRecord #ENDIF #FOR(%Formula) #IF((UPPER(%FormulaClass) = 'AVG' OR UPPER(%FormulaClass)='CNT')) %Formula# -= Old::%Formula# #ENDIF #IF((UPPER(%FormulaClass) = 'SUM' OR UPPER(%FormulaClass)='AVG')) %Formula$ -= Old::%Formula$ #ENDIF #ENDFOR END #ENDIF #IF(%KeyboardChange OR %KeyboardInsert) #! IF Change or Delete Active #IF(%KeyboardChange AND %KeyboardInsert) IF UpdateMode = ChangeRecord OR UpdateMode = AddRecord #ELSIF(%KeyboardChange) IF UpdateMode = ChangeRecord #ELSE IF UpdateMode = AddRecord #!If Changing or Adding #ENDIF LOOP #IF(%KeyRangeField) #!If using range limits #INSERT(%RangeComparison) BREAK END #ENDIF #IF(%FilterExists) #IF(%RecordFilter) IF ~(%RecordFilter) #<!If Filter condition not met BREAK END #ENDIF #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'FILTER') #IF(%FormulaType <> 'COMPUTED') IF ~(%FormulaCondition) #<!If Filter condition not met BREAK END !End IF #ELSE IF ~(%FormulaComputation) #<!If Filter condition not met BREAK END !End IF #ENDIF #ENDIF #ENDFOR #ENDIF #INSERT(%AddTotalValues) BREAK END END #ENDIF END #INSERT(%UpdateTotalValues) #ENDIF #! END (If Formulas...) #ENDIF #!*************************************************************************** #GROUP(%AddTotalValues) #! Adding values to totals #FOR(%Formula) #! FOR each Formula #IF(%FormulaType = 'COMPUTED') #! If COMPUTED formula #IF((UPPER(%FormulaClass) = 'CNT' OR UPPER(%FormulaClass)='AVG')) %Formula# += 1 #<!TOTAL:%FormulaDescription #ENDIF #! ENDIF (Count or Avg) #IF((UPPER(%FormulaClass) = 'SUM' OR UPPER(%FormulaClass)='AVG')) %Formula$ += %FormulaComputation #<!TOTAL:%FormulaDescription #ENDIF #! ENDIF (Sum or Avg) #ELSE #! If CONDITIONAL formula IF %FormulaCondition #<!TOTAL:%FormulaDescription #IF((UPPER(%FormulaClass) = 'CNT' OR UPPER(%FormulaClass)='AVG')) %Formula# += 1 #<!TOTAL:%FormulaDescription #ENDIF #! ENDIF (Count or Avg) #IF((UPPER(%FormulaClass) = 'SUM' OR UPPER(%FormulaClass)='AVG')) %Formula$ += %FormulaTrue #<!TOTAL:%FormulaDescription #ENDIF #! ENDIF (Sum or Avg) #IF(%FormulaFalse) #! IF the formula has FALSE val ELSE #<! IF the condition is FALSE #IF((UPPER(%FormulaClass) = 'CNT' OR UPPER(%FormulaClass)='AVG')) %Formula# += 1 #<! TOTAL:%FormulaDescription #ENDIF #! ENDIF (Count or Avg) #IF((UPPER(%FormulaClass) = 'SUM' OR UPPER(%FormulaClass)='AVG')) %Formula$ += %FormulaFalse #<! TOTAL:%FormulaDescription #ENDIF #! ENDIF (Sum or Avg) #ENDIF #! ENDIF (False condition...) END #<! END (IF Condition...) #ENDIF #! ENDIF (Conditional formula) #ENDFOR #! END (For Formula...) #!*************************************************************************** #GROUP(%UpdateTotalValues) #! Updates Totals and screen #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ UpdateTotalValues │Version: 3007.101│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Fill Total formula fields from the accumulation fields │ #!│Called From: Browse,Validate,Lookup,Select │ #!│Assumptions: That the GROUP will be called only if totals exist │ #!│Inserts: None │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.101 Repaired code to handle divide by zero on COUNT totals │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #FOR(%Formula) #! FOR each formula #IF(UPPER(%FormulaClass) = 'SUM') #! IF a SUM formula %Formula = %Formula$ #<! Move sum to variable #ELSIF(UPPER(%FormulaClass) = 'AVG') #! If Average formula IF %Formula# #<! IF not divide by zero %Formula = %Formula$/%Formula# #<! Move average to variable ELSE #<! ELSE (IF not divide...) %Formula = 0 #<! Clear variable END #<! END (If not divide...) #ELSIF(UPPER(%FormulaClass) = 'CNT') #! If Count formula %Formula = %Formula# #<! Move count to variable #ENDIF #! ENDIF (FormulaClass...) #ENDFOR #! ENDFOR (Formula...) #!*************************************************************************** #GROUP(%ClearTotalValues) #! Clears Totals and screen #FOR(%Formula) #! FOR each formula #IF(UPPER(%FormulaClass) = 'SUM') #! IF a SUM formula %Formula$ = 0 #<! Clear variable #ELSIF(UPPER(%FormulaClass) = 'AVG') #! If Average formula %Formula$ = 0 #<! Clear variable %Formula# = 0 #<! Clear variable #ELSIF(UPPER(%FormulaClass) = 'CNT') #! If Count formula %Formula# = 0 #<! Clear variable #ENDIF #! ENDIF (FormulaClass...) #ENDFOR #! ENDFOR (Formula...) #!*************************************************************************** #GROUP(%SetupKeyRangeFields) #SET(%RangeSaveFields,%Null) #SET(%RangeRestoreFields,%Null) #SET(%RangeRestoreAll,%Null) #SET(%BreakAfterGenerate,%Null) #IF(%KeyRangeField) #!If range limit prompt #IF(%TotalExists) SAV::RangeValueChanged BYTE #ENDIF #FIX(%File,%Primary) #!Fix to procedure's primary #FIX(%Key,%PrimaryKey) #!Fix to primary access key #FOR(%KeyField) #!For all key components #SET(%RangeSaveFields,(%RangeSaveFields+1)) #IF(upper(%KeyField) = upper(%KeyRangeField))#!If on the range field #SET(%GenerateSaveValues,%Null) #SET(%BreakAfterGenerate,'TRUE') #IF((UPPER(%RangeValue)=UPPER(%KeyField))) #!If a range value is given #SET(%GenerateSaveValues,'TRUE') #ELSIF(%RangeValue) #ELSE #SET(%GenerateSaveValues,'TRUE') #ENDIF #ELSE #SET(%GenerateSaveValues,'TRUE') #ENDIF #IF(%GenerateSaveValues) #!Do Nothing, otherwise #SET(%RangeRestoreFields,(%RangeRestoreFields+1)) #FIX(%Field,%KeyField) #!Fix to component of key #IF(%FieldType = 'GROUP') #!If component is a group SAV::%KeyField LIKE(%KeyField),PRE(SAV) #<!Save Range Limit Group #ELSE #!Else component NOT a group SAV::%KeyField LIKE(%KeyField) #<!Save Range Limit Field #ENDIF #!EndIf component is a group #ENDIF #!EndIf %RangeValue not used #IF(%BreakAfterGenerate) #BREAK #ENDIF #ENDFOR #!EndFor all key components #IF(%RangeSaveFields=%RangeRestoreFields) #SET(%RangeRestoreAll,'TRUE') #ENDIF #ENDIF #!EndIf range limit prompt #!*************************************************************************** #GROUP(%SaveRangeFields) #IF(%KeyRangeField) #!If using range limits #SET(%FieldsToSave,%Null) #FOR(%KeyField) #!for all key components #IF(%RangeRestoreAll OR (%FieldsToSave<%RangeRestoreFields)) SAV::%KeyField = %KeyField #<! Save Key Field #ENDIF #SET(%FieldsToSave,(%FieldsToSave+1)) #IF(%FieldsToSave=%RangeRestoreFields) #BREAK #ENDIF #ENDFOR #!EndFor KeyFields #ENDIF #!EndIF KeyRangeField #!*************************************************************************** #GROUP(%RestoreRangeFields) #IF(%KeyRangeField) #!If using range limits #SET(%FieldsToSave,%Null) #FOR(%KeyField) #!for all key components #IF(%RangeRestoreAll) %KeyField = SAV::%KeyField #<! Restore Key Field #ELSE #IF(%FieldsToSave<%RangeRestoreFields) %KeyField = SAV::%KeyField #<! Restore Key Field #ELSE %KeyField = %RangeValue #<! Restore Range Value #ENDIF #ENDIF #SET(%FieldsToSave,(%FieldsToSave+1)) #IF(%FieldsToSave=%RangeSaveFields) #BREAK #ENDIF #ENDFOR #!EndFor KeyFields #ENDIF #!EndIF KeyRangeField #!*************************************************************************** #GROUP(%CheckKeyRangeFields) #IF(%KeyRangeField) #!If using range limits #INSERT(%RangeComparison) PREVIOUS(%Primary) #<! Signal build #INSERT(%ClearFileFields) #!Clear for screen fields #INSERT(%RestoreRangeFields) #!Restore range values CYCLE #<! Cycle END #<! End IF #ENDIF #!EndIF KeyRangeField #!*************************************************************************** #GROUP(%RangeComparison) #SET(%IfWritten,%Null) #!Clear the %Found flag #SET(%FieldsToSave,%Null) #FOR(%KeyField) #!for all key components #IF((%RangeRestoreAll OR (%FieldsToSave<%RangeRestoreFields))) #IF(%KeyNoCase) #SET(%Comparison,('(UPPER(' & %KeyField & ') <> UPPER(SAV::' & %KeyField & '))')) #ELSE #SET(%Comparison,(%KeyField & ' <> SAV::' & %KeyField )) #ENDIF #ELSE #IF(%KeyNoCase) #SET(%Comparison,('(UPPER(' & %KeyField & ') <> UPPER(' & %RangeValue & '))')) #ELSE #SET(%Comparison,(%KeyField & ' <> ' & %RangeValue)) #ENDIF #ENDIF #SET(%FieldsToSave,(%FieldsToSave+1)) #SET(%LastComparison,%Null) #IF(%FieldsToSave=%RangeSaveFields) #SET(%LastComparison,'TRUE') #ENDIF #IF(%LastComparison) #IF(%IfWritten) OR %Comparison #ELSE IF %Comparison #SET(%IfWritten,'TRUE') #ENDIF #BREAK #ELSE #IF(%IfWritten) OR %Comparison | #ELSE IF %Comparison | #SET(%IfWritten,'TRUE') #ENDIF #ENDIF #ENDFOR #!EndFor KeyFields #!*************************************************************************** #GROUP(%EditCodeInsert) #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ EditCodeInsert │Version: 3007.103│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Generate code for ?Insert Button on Browse procedures │ #!│Called From: Any BROWSE type procedure │ #!│Assumptions: That %ScreenField is FIXed to the ?Insert field │ #!│Inserts: ClearFileFields │ #!│ RestoreRangeFields │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.102 Added assignment to UpdateMode to allow updating of totals │ #!│3007.103 Remove SELECT(?List) from GROUP (Added to UpdateProcedure) │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #IF(%UpdateProc) OF ?Insert !Process the Insert Button #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Insert button Edit Routine #ENDIF #INSERT(%ClearFileFields) #INSERT(%RestoreRangeFields) UpdateMode = AddRecord SETKEYCODE(InsKey) ! Set action to Insert Do UpdateProcedure ! Call the update procedure #ENDIF #!*************************************************************************** #GROUP(%EditCodeChange) #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ EditCodeChange │Version: 3007.103│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Generate code for ?Change Button on Browse procedures │ #!│Called From: Any BROWSE type procedure │ #!│Assumptions: That %ScreenField is FIXed to the ?Change field │ #!│Inserts: None │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.102 Added assignment to UpdateMode to allow updating of totals │ #!│3007.103 Remove SELECT(?List) from GROUP (Added to UpdateProcedure) │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #IF(%UpdateProc) OF ?Change !Process the Change Button #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Change button Edit Routine #ENDIF UpdateMode = ChangeRecord SETKEYCODE(EnterKey) ! Set action to Change Do UpdateProcedure ! Call the update procedure #ENDIF #!*************************************************************************** #GROUP(%EditCodeDelete) #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ EditCodeDelete │Version: 3007.103│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Generate code for ?Delete Button on Browse procedures │ #!│Called From: Any BROWSE type procedure │ #!│Assumptions: That %ScreenField is FIXed to the ?Delete field │ #!│Inserts: None │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.102 Added assignment to UpdateMode to allow updating of totals │ #!│3007.103 Remove SELECT(?List) from GROUP (Added to UpdateProcedure) │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #IF(%UpdateProc) OF ?Delete !Process the Delete Button #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Delete button Edit Routine #ENDIF UpdateMode = DeleteRecord SETKEYCODE(DelKey) ! Set action to Delete DO UpdateProcedure ! Call the update procedure #ENDIF #!*************************************************************************** #GROUP(%EditCodeSelect) OF ?Select #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Exit button Edit Routine #ENDIF #IF(%KeyboardSelect) SETKEYCODE(EnterKey) #ENDIF DO ProcedureReturn #!*************************************************************************** #GROUP(%EditCodeExit) OF ?Exit !Process the Exit button #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Exit button Edit Routine #ENDIF #IF(%KeyboardSelect) IF CalledAsLookup SETKEYCODE(EscKey) GET(%Primary,0) #FIX(%File,%Primary) CLEAR(%FilePre:Record,0) END #ENDIF DO ProcedureReturn #!*************************************************************************** #GROUP(%EditCodeCancel) OF ?Cancel !Process the Exit button #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Exit button Edit Routine #ENDIF #IF(%KeyboardSelect) IF CalledAsLookup SETKEYCODE(EscKey) GET(%Primary,0) #FIX(%File,%Primary) CLEAR(%FilePre:Record,0) END #ENDIF DO ProcedureReturn #!*************************************************************************** #GROUP(%EditCodeLocator) #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ EditCodeLocator │Version: 3007.103│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Process CASE FIELD() of ?Locator code │ #!│Called From: ALL Browse-Based Procedures │ #!│Assumptions: None │ #!│Inserts: None │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.103 Added during 3007.103 Template Release │ #!└──────────────────────────────────────────────────────────────────────────┘ #! OF ?%Locator !Process the Locator #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Exit button Edit Routine #ENDIF #!*************************************************************************** #GROUP(%EditCodeList) #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ EditCodeList │Version: 3007.105│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Generates "OF ?List" code in Browse CASE Field() code │ #!│Called From: Browse-type procedures │ #!│Assumptions: None │ #!│Inserts: None │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.103 Repaired code for %KeyboardSelect and no %UpdateProc │ #!│3007.105 Repaired handling of KEYCODE() = CtrlEnter (now we issue │ #!│ SETKEYCODE(EnterKey) to tell the form that we're editing. │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #IF(%UpdateProc) OF ?List !Process the list field CASE KEYCODE() ! Jump to keycode routine #IF(%KeyboardInsert) OF InsKey ! For the insert key #INSERT(%ClearFileFields) #INSERT(%RestoreRangeFields) UpdateMode = AddRecord DO UpdateProcedure ! Call the update procedure #ENDIF #IF(%KeyboardDelete) OF DelKey ! For the delete key UpdateMode = DeleteRecord DO UpdateProcedure ! Call the update procedure #ENDIF #IF(%KeyboardSelect) OF EnterKey OROF MouseLeft2 #IF((UPPER(%ProcedureTemplate)='BROWSE' OR UPPER(%ProcedureTemplate)='SELECT')) IF CalledAsLookup SETKEYCODE(EnterKey) DO ProcedureReturn ELSE UpdateMode = ChangeRecord DO UpdateProcedure ! Call the update procedure END #ELSE #INSERT(%LookupValidateCode) #ENDIF OF CtrlEnter IF CalledAsLookup SETKEYCODE(EnterKey) UpdateMode = ChangeRecord DO UpdateProcedure ! Call the update procedure END #ELSIF(%KeyboardChange) OF EnterKey ! Or the enter key OROF MouseLeft2 ! Or a double mouse click UpdateMode = ChangeRecord DO UpdateProcedure ! Call the update procedure #ENDIF END ! End CASE #ELSIF(%KeyboardSelect) OF ?List !Process the list field #IF((UPPER(%ProcedureTemplate)='BROWSE' OR UPPER(%ProcedureTemplate)='SELECT')) IF CalledAsLookup IF KEYCODE() = MouseLeft2 or KEYCODE() = EnterKey SETKEYCODE(EnterKey) DO ProcedureReturn END END #ELSE #INSERT(%LookupValidateCode) #ENDIF #ENDIF #!*************************************************************************** #GROUP(%ClearRecordHigh) CLEAR(%FilePre:Record,1) #FIX(%Key,%PrimaryKey) #FOR(%KeyField) #IF(%KeyFieldSequence='DESCENDING') CLEAR(%KeyField,-1) #ENDIF #ENDFOR #!*************************************************************************** #GROUP(%ClearRecordLow) CLEAR(%FilePre:Record,-1) #FIX(%Key,%PrimaryKey) #FOR(%KeyField) #IF(%KeyFieldSequence='DESCENDING') CLEAR(%KeyField,1) #ENDIF #ENDFOR #!*************************************************************************** #GROUP(%LookupValidateCode) #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ LookupValidateCode │Version: 3007.103│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Generate code for Validate and Lookup Procedures │ #!│Called From: EditCodeList GROUP │ #!│Assumptions: None │ #!│Inserts: None │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.103 Added support for SAV::PullDownOpened for Lookup and Validate. │ #!│ This support was added because any screen and pulldown needs to │ #!│ be closed so CHANGE only affect the calling screen. │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #IF(%ScreenFieldEdit) %ScreenFieldEdit #<!Select button Edit Routine #ENDIF #IF(%Pulldown) #!If a Pulldown exists IF SAV::PullDownOpened CLOSE(%Pulldown) #<!Close the Pulldown SAV::PullDownOpened = False END #ENDIF CLOSE(%Screen) !Close the screen #IF((UPPER(%ProcedureTemplate)='VALIDATE')) SELECT(?) !Select the same field #ENDIF CHANGE(SELECTED(),%LookupField) !Change to New Value PRESS(TabKey) ! and a tab key DO ProcedureReturn !Return to caller #! #!*************************************************************************** #GROUP(%LookupRecord) #!Group to Lookup a record #IF(%FromLookup) #IF(%LookupPicture) DeformatString = CONTENTS(SELECTED()) #<! Fill the Key Value #ELSE %LookupField = CONTENTS(SELECTED()) #<! Fill the Key Value #ENDIF #ELSE #IF(%LookupPicture) DeformatString = CONTENTS(FIELD()) #<! Fill the Key Value #ELSE %LookupField = CONTENTS(FIELD()) #<! Fill the Key Value #ENDIF #ENDIF #IF(%LookupPicture) %LookupField = DEFORMAT(DeformatString,%LookupPicture) #ENDIF GET(%Primary,%LookupKey) #<! Get the matching record IF ~ERRORCODE() #<! If found then return DO ProcedureReturn END #!*************************************************************************** #GROUP(%IsUpdateSuccessful) UpdateSuccessful = True #IF(%KeyboardDelete) IF POSITION(%Primary) IF UpdateMode = DeleteRecord UpdateSuccessful = False END #IF(%KeyboardChange OR %KeyboardInsert) ELSE #IF(%KeyboardChange AND %KeyboardInsert) IF UpdateMode = ChangeRecord OR UpdateMode = AddRecord #ELSIF(%KeyboardChange) IF UpdateMode = ChangeRecord #ELSE IF UpdateMode = AddRecord #!If Changing or Adding #ENDIF UpdateSuccessful = False END #ENDIF END #ELSIF(%KeyboardChange OR %KeyboardInsert) IF NOT POSITION(%Primary) #IF(%KeyboardChange AND %KeyboardInsert) IF UpdateMode = ChangeRecord OR UpdateMode = AddRecord #ELSIF(%KeyboardChange) IF UpdateMode = ChangeRecord #ELSE IF UpdateMode = AddRecord #!If Changing or Adding #ENDIF UpdateSuccessful = False END END #ENDIF #!*************************************************************************** #CHAIN('ChldGrps.tpx')